home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE20 / LISTBOX / CUSTOMU2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-25  |  4.0 KB  |  171 lines
  1. unit CustomU2;
  2.  
  3. interface
  4.  
  5. uses
  6.   WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, Buttons;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     LstVariable: TListBox;
  12.     BtnFindIt: TSpeedButton;
  13.     BtnDoIt: TBitBtn;
  14.     EdtDir: TEdit;
  15.     OpenDialog1: TOpenDialog;
  16.     CmbVariable: TComboBox;
  17.     procedure FormCreate(Sender: TObject);
  18.     procedure FormDestroy(Sender: TObject);
  19.     procedure BtnDoItClick(Sender: TObject);
  20.     procedure BtnFindItClick(Sender: TObject);
  21.     procedure LstVariableMeasureItem(Control: TWinControl; Index: Integer;
  22.       var Height: Integer);
  23.     procedure LstVariableDrawItem(Control: TWinControl; Index: Integer;
  24.       Rect: TRect; State: TOwnerDrawState);
  25.     procedure CmbVariableMeasureItem(Control: TWinControl; Index: Integer;
  26.       var Height: Integer);
  27.     procedure CmbVariableDrawItem(Control: TWinControl; Index: Integer;
  28.       Rect: TRect; State: TOwnerDrawState);
  29.   public
  30.     Bmps: TStrings;
  31.   end;
  32.  
  33. var
  34.   Form1: TForm1;
  35.  
  36. implementation
  37.  
  38. {$R *.DFM}
  39.  
  40. procedure EmptyBmpList(S: TStrings);
  41. begin
  42.   with S do
  43.     while Count > 0 do
  44.     begin
  45.       Objects[0].Free;
  46.       Delete(0);
  47.     end;
  48. end;
  49.  
  50. procedure LoadBitmaps(const Path: String; S: TStrings);
  51. var
  52.   Bmp: TBitmap;
  53.   SearchRec: TSearchRec;
  54. begin
  55.   EmptyBmpList(S);
  56.   with S do
  57.   begin
  58.     BeginUpdate;
  59.     if FindFirst(Path + '*.bmp', faAnyFile, SearchRec) = 0 then
  60.       try
  61.         repeat
  62.           Bmp := TBitmap.Create;
  63.           Bmp.LoadFromFile(Path + SearchRec.Name);
  64.           AddObject(SearchRec.Name, Bmp);
  65.         until FindNext(SearchRec) <> 0;
  66.       finally
  67.         FindClose(SearchRec);
  68.       end;
  69.     EndUpdate;
  70.   end;
  71. end;
  72.  
  73. procedure TForm1.FormCreate(Sender: TObject);
  74. begin
  75.   Bmps := TStringList.Create
  76. end;
  77.  
  78. procedure TForm1.FormDestroy(Sender: TObject);
  79. begin
  80.   EmptyBmpList(Bmps);
  81.   Bmps.Free;
  82. end;
  83.  
  84. procedure TForm1.BtnDoItClick(Sender: TObject);
  85. begin
  86.   if Length(EdtDir.Text) = 0 then
  87.     raise Exception.Create('Type a path in the edit control');
  88.   if EdtDir.Text[Length(EdtDir.Text)] <> '\' then
  89.     EdtDir.Text := EdtDir.Text + '\';
  90.   Screen.Cursor := crHourGlass;
  91.   try
  92.     LoadBitmaps(EdtDir.Text, Bmps);
  93.   finally
  94.     Screen.Cursor := crDefault;
  95.   end;
  96.   TStringList(Bmps).Sort;
  97.   LstVariable.Items := Bmps;
  98.   CmbVariable.Items := Bmps;
  99. end;
  100.  
  101. procedure TForm1.BtnFindItClick(Sender: TObject);
  102. begin
  103.   with OpenDialog1 do
  104.   begin
  105.     InitialDir := EdtDir.Text;
  106.     if Execute then
  107.     begin
  108.       EdtDir.Text := ExtractFilePath(FileName);
  109.       BtnDoIt.Click
  110.     end
  111.   end
  112. end;
  113.  
  114. procedure TForm1.LstVariableMeasureItem(Control: TWinControl;
  115.   Index: Integer; var Height: Integer);
  116. begin
  117.   if Index >= 0 then
  118.     with Bmps do
  119.       if Objects[Index] <> nil then
  120.         Height := TBitmap(Objects[Index]).Height;
  121. end;
  122.  
  123. procedure TForm1.LstVariableDrawItem(Control: TWinControl; Index: Integer;
  124.   Rect: TRect; State: TOwnerDrawState);
  125. var
  126.   Bmp: TBitmap;
  127.   R: TRect;
  128. begin
  129.   with LstVariable, Items, Canvas, Rect do
  130.   begin
  131.     FillRect(Rect);
  132.     Bmp := TBitmap(Objects[Index]);
  133.     Draw(Left, Top, Bmp);
  134.     if odSelected in State then
  135.     begin
  136.       R := Bounds(Left, Top, Bmp.Width, Bmp.Height);
  137.       InvertRect(Handle, R)
  138.     end;
  139.   end
  140. end;
  141.  
  142. procedure TForm1.CmbVariableMeasureItem(Control: TWinControl;
  143.   Index: Integer; var Height: Integer);
  144. begin
  145.   if Index >= 0 then
  146.     with Bmps do
  147.       if Objects[Index] <> nil then
  148.         Height := TBitmap(Objects[Index]).Height;
  149. end;
  150.  
  151. procedure TForm1.CmbVariableDrawItem(Control: TWinControl; Index: Integer;
  152.   Rect: TRect; State: TOwnerDrawState);
  153. var
  154.   Bmp: TBitmap;
  155.   R: TRect;
  156. begin
  157.   with CmbVariable, Items, Canvas, Rect do
  158.   begin
  159.     FillRect(Rect);
  160.     Bmp := TBitmap(Objects[Index]);
  161.     Draw(Left, Top, Bmp);
  162.     if odSelected in State then
  163.     begin
  164.       R := Bounds(Left, Top, Bmp.Width, Bmp.Height);
  165.       InvertRect(Handle, R)
  166.     end;
  167.   end
  168. end;
  169.  
  170. end.
  171.